home *** CD-ROM | disk | FTP | other *** search
/ Aminet 41 / Aminet 41 (2001)(Schatztruhe)[!][Feb 2001].iso / Aminet / gfx / edit / AmiCAD_2.07.lha / AmiCAD / ARexx / Recopier.AmiCAD < prev    next >
Text File  |  2000-11-10  |  5KB  |  180 lines
  1. /* Clonage d'un composant, en "augmentant sa référence"
  2.    Version 1.00: 22 décembre 1998
  3.    Version 1.01: 25 Février 1999 (modif appel ASKNUM)
  4.    Version 1.02: 13 Avril 2000 (adaptation version 2.05)
  5.    Version 1.03: 1 Novembre 2000 (correction bugs, copie à gauche)
  6.    Version 1.04: 10 Novembre 2000 (localisation anglais/français)
  7.     $VER: 1.04 (© R.Florac, 10 Novembre 2000)
  8.    Améliorations à faire: traitement références multiples, composants sans référence
  9. */
  10.  
  11. options results     /* indispensable pour récupérer le résultat des macros */
  12.  
  13. signal on error     /* pour l'interception des erreurs */
  14. signal on syntax
  15.  
  16. 'LANGUAGE'
  17. if result="français.language" then fr=1
  18. else fr=0
  19.  
  20. 'FIRSTSEL'
  21. o=result
  22. if o=0 then do
  23.     if fr=1 then 'MESSAGE("Sélectionnez le"+CHR(10)+"composant à recopier"+CHR(10)+"avant d''appeler ce script")'
  24.     else 'MESSAGE("Select the component"+CHR(10)+"to duplicate"+CHR(10)+"before calling this script")'
  25.     exit
  26. end
  27.  
  28. type=0
  29. do while type=0
  30.     'TYPE('o')'
  31.     select
  32.     when result=1 then do
  33.         type=1
  34.         leave
  35.     end
  36.     when result=4 then do
  37.         type=4
  38.         leave
  39.     end
  40.     when result=11 then do
  41.         type=11
  42.         leave
  43.     end
  44.     when result=12 then do
  45.         type=12
  46.         leave
  47.     end
  48.     otherwise nop
  49.     end
  50.     'NEXTSEL('o')'; o=result
  51.     if o=0 then do
  52.     if fr=1 then 'MESSAGE("Sélection incorrecte")'
  53.     else 'MESSAGE("Bad selection")'
  54.     exit
  55.     end
  56. end
  57.  
  58. if type=1 then 'READTEXT(GETREF('o'))'
  59. else 'READTEXT('o')'
  60. ref=result
  61. j=numero_reference(ref)
  62. ref=reference(ref)
  63. 'WIDTH(0)'; l=(result%10)*10
  64. 'HEIGHT(0)'; h=(result%10)*10
  65. 'COL(0)'; x0=result
  66. 'LINE(0)'; y0=result
  67. if fr=1 then 'SELECT("Sens de la copie"+CHR(10)+"Vers le bas"+CHR(10)+"Vers la droite"+CHR(10)+"Vers le haut"+CHR(10)+"Vers la gauche")'
  68. else 'SELECT("Copying direction"+CHR(10)+"To bottom"+CHR(10)+"To right"+CHR(10)+"To top"+CHR(10)+"To left")'
  69. sens=result
  70. if sens < 1 then exit
  71. if fr=1 then 'ASKNUM("Combien de fois"+CHR(10)+"voulez-vous effectuer"+CHR(10)+"l''opération?",2)'
  72. else 'ASKNUM("How many times"+CHR(10)+"do-you want to do"+CHR(10)+"the operation?",2)'
  73. n=result
  74. if n<1 then exit
  75. if fr=1 then 'SELECT("Espace entre les copies"+CHR(10)+"10 pixels"+CHR(10)+"20 pixels"+CHR(10)+"30 pixels"+CHR(10)+"Automatique"+CHR(10)+"Spécifié")'
  76. else 'SELECT("Space between the copies"+CHR(10)+"10 pixels"+CHR(10)+"20 pixels"+CHR(10)+"30 pixels"+CHR(10)+"Automatique"+CHR(10)+"Spécifié")'
  77. pas = result
  78. select
  79.     when pas=1 then pas=0
  80.     when pas=2 then pas=10
  81.     when pas=3 then pas=20
  82.     when pas=4 then do
  83.     if sens=1 | sens=3 then pas=h
  84.     else pas=l
  85.     end
  86.     when pas=5 then do
  87.     if fr=1 then 'ASKNUM("Pas entre les copies",10)'
  88.     else 'ASKNUM("Step between the copies",10)'
  89.     pas=result
  90.     end
  91.     otherwise exit
  92. end
  93.  
  94. 'COPY(5):SAVEALL'           /* sauvegarde des éléments à copier */
  95. do i=1 to n
  96.     select
  97.     when sens=1 then do    /* Copie vers le bas */
  98.         yy=y0+(10+pas+h)*i
  99.         yy=(yy%10)*10
  100.         'PASTE(5,'x0','yy')'
  101.     end
  102.     when sens=2 then do    /* Copie vers la droite */
  103.         xx=x0+(10+pas+l)*i
  104.         xx=(xx%10)*10
  105.         'PASTE(5,'xx','y0')'
  106.     end
  107.     when sens=3 then do    /* Copie vers le haut */
  108.         yy=y0-(10+pas+h)*i
  109.         yy=(yy%10)*10
  110.         'PASTE(5,'x0','yy')'
  111.     end
  112.     otherwise do        /* Copie vers la gauche (v1.03) */
  113.         xx=x0-(10+pas+l)*i
  114.         xx=(xx%10)*10
  115.         'PASTE(5,'xx','y0')'
  116.     end
  117.     end
  118.     if ref ~= "" then do
  119.     j=j+1
  120.     k=indice(type)
  121.     if type=1 then 'SETREF('k',"'ref||j'"):UNMARK(-1)'
  122.     else 'SETTEXT('k',"'ref||j'"):UNMARK(-1)'
  123.     end
  124. end
  125.  
  126. exit
  127.  
  128. indice: procedure
  129.     parse arg type
  130.     'FIRSTSEL'
  131.     o=result
  132.     do while o>0
  133.     'TYPE('o')'
  134.     select
  135.         when result=type then return o
  136.         otherwise nop
  137.     end
  138.     'NEXTSEL('o')'; o=result
  139.     end
  140.     return 0
  141.  
  142. reference: procedure
  143.     parse arg ref
  144.     i=length(ref)
  145.     do while i>1
  146.     c=substr(ref,i,1)
  147.     if datatype(c)=NUM then ref=left(ref,i-1)
  148.     else return ref
  149.     i=i-1
  150.     end
  151.     return ref
  152.  
  153. numero_reference: procedure
  154.     parse arg ref
  155.     i=length(ref)
  156.     r=0
  157.     rang=1
  158.     do while i>1
  159.     c=substr(ref,i,1)
  160.     if datatype(c)=NUM then do
  161.         r=r+c*rang
  162.         rang=rang*10
  163.     end
  164.     else return r
  165.     i=i-1
  166.     end
  167.     return r
  168.  
  169. /* Traitement des erreurs, interruption du programme */
  170. syntax:
  171. erreur=RC
  172. if fr=1 then 'MESSAGE("Script Recopier.AmiCAD"+CHR(10)+"Erreur de syntaxe"+CHR(10)+"en ligne 'SIGL'"+CHR(10)+"'errortext(erreur)'")'
  173. else 'MESSAGE("Recopier.AmiCAD script"+CHR(10)+"Syntax error"+CHR(10)+"in line 'SIGL'"+CHR(10)+"'errortext(erreur)'")'
  174. exit
  175.  
  176. error:
  177. if fr=1 then 'MESSAGE("Script Recopier.AmiCAD"+CHR(10)+"Erreur en ligne 'SIGL'")'
  178. else 'MESSAGE("Recopier.AmiCAD script"+CHR(10)+"Error in line 'SIGL'")'
  179. exit
  180.